{*******************************************************************************
* The contents of this file are used with permission, subject to the Mozilla   *
* Public License Version 1.1 (the "License"); you may not use this file except *
* in compliance with the License. You may obtain a copy of the License at      *
* http://www.mozilla.org/MPL/                                                  *
*                                                                              *
* Software distributed under the License is distributed on an "AS IS" basis,   *
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for *
* the specific language governing rights and limitations under the License.    *
*                                                                              *
* The Original Code is distributed as part of the "mediate" product and is     *
* Copyright (C) @home media limited. All Rights Reserved.                      *
*                                                                              *
* Email: support@athomemedia.co.uk                                             *
* Web:   http://www.athomemedia.co.uk                                          *
*******************************************************************************}

unit Mapping;

interface

uses Classes;

type
  TAHMIRActionType = (atSimple, atLaunch);

  TAHMIRAction = class
  private
    FActionType: TAHMIRActionType;
  protected
  public
    property ActionType: TAHMIRActionType read FActionType write FActionType;
    procedure CallAction; virtual; abstract;
  end;

  TAHMIRKeyAction = class(TAHMIRAction)
  private
    FKeyCode: Integer;
  protected
  public
    property KeyCode: Integer read FKeyCode write FKeyCode;
    procedure CallAction; override;
  end;

  TAHMIRMappings = class
  private
    FUpdating: Boolean;
    FMappings: TStringList;
  protected
  public
    constructor Create;
    destructor Destroy; override;
    procedure BeginUpdate;
    procedure ClearMappings;
    procedure AddMapping(Name: String; KeyCode: Integer); overload;
    procedure AddMapping(Name: String; KeyCode: Integer; ActionType: TAHMIRActionType); overload;
    procedure EndUpdate;
    procedure HandleMessage(MessageName: String);
  end;

var
  MappingsInstance: TAHMIRMappings;

implementation

uses SysUtils, Mediate;

// TAHMIRKeyAction

procedure TAHMIRKeyAction.CallAction;
begin
  // Send keycode to mediate
  SendKeyCode(FKeyCode);
end;

// TAHMIRMappings

constructor TAHMIRMappings.Create;
begin
  inherited Create;

  // Create mappings list
  FMappings := TStringList.Create;
end;

destructor TAHMIRMappings.Destroy;
begin
  FUpdating := True;
  ClearMappings;
  FMappings.Free;

  inherited Destroy;
end;

procedure TAHMIRMappings.BeginUpdate;
begin
  FUpdating := True;
  FMappings.Sorted := False;
end;

procedure TAHMIRMappings.ClearMappings;
var
  i: Integer;
begin
  if not FUpdating then
    raise Exception.Create('IR mappings not in update mode for clearing')
  else
  begin
    // Free owned IR action objects
    for i := 0 to Pred(FMappings.Count) do
      TAHMIRAction(FMappings.Objects[i]).Free;
    FMappings.Clear;
  end;
end;

procedure TAHMIRMappings.AddMapping(Name: String; KeyCode: Integer);
begin
  // Defer to method below
  AddMapping(Name, KeyCode, atSimple);
end;

procedure TAHMIRMappings.AddMapping(Name: String; KeyCode: Integer; ActionType: TAHMIRActionType);
var
  Action: TAHMIRKeyAction;
begin
  if not FUpdating then
    raise Exception.Create('IR mappings not in update mode for adding')
  else
  begin
    // Create and configure new action instance
    Action := TAHMIRKeyAction.Create;
    Action.KeyCode := KeyCode;
    Action.ActionType := ActionType;

    FMappings.AddObject(Name, Action);
  end;
end;

procedure TAHMIRMappings.EndUpdate;
begin
  if not FUpdating then
    raise Exception.Create('IR mappings not in update mode for end update')
  else
  begin
    FUpdating := False;
    FMappings.Sorted := True;
  end;
end;

procedure TAHMIRMappings.HandleMessage(MessageName: String);
var
  Index: Integer;
  Action: TAHMIRAction;
begin
  // Look for corresponding action to send to mediate
  Index := FMappings.IndexOf(MessageName);
  if Index >= 0 then
  begin
    Action := TAHMIRAction(FMappings.Objects[Index]);
    // Does this action type require us to launch mediate?
    if (Action.ActionType = atLaunch) and not CheckMediateRunning then
      LaunchMediate
    else
      Action.CallAction;
  end;
end;


initialization
  MappingsInstance := TAHMIRMappings.Create;

finalization
  MappingsInstance.Free;

end.
